home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / amos / amos_col.lha / AMOS-COL / CHAOS.amos / CHAOS.amosSourceCode < prev    next >
AMOS Source Code  |  1980-01-10  |  26KB  |  983 lines
  1. 'By Delta/Opium
  2. '
  3. '�ukasz ï¿½elezny
  4. 'ul. W�oska 4D/6 
  5. '42-612 Tarnowskie G�ry  
  6. 'Poland
  7. '
  8. Set Buffer 20
  9. On Error Proc BAD
  10. Trap Screen Close 0
  11. BLOKUJ
  12. Degree 
  13. Dim SN#(1360),PRV(16),HA$(9)
  14. Dim X(10),Y(10),WSK(160),WSP(160)
  15. Dim KOL(32)
  16. For I=0 To 1360 : Doke $DFF180,Rnd(4090) : SN#(I)=Sin(I) : Next I
  17. Global KOL(),NR,ZNAK$,SN#(),PRV(),HA$(),WSK(),WSP(),Y_POS
  18. CREDITS
  19. ALIENS
  20. AKFARELA[160,128,2000,1]
  21. _SINUS
  22. CHESSBOARD_3D
  23. _3DCUBE
  24. ROTATOR
  25. COPPER
  26. LUSTRO
  27. _SCROLL
  28. ELVIS
  29. BRY�Y
  30. _END_SCROLL
  31. Procedure ALIENS
  32.    Unpack 10 To 0 : Erase 10 : Screen Display 0,,-220,, : Screen Hide 0 : KOLORY : Screen Show 0
  33.    For Z=-220 To 40 : Screen Display 0,,Z,, : Wait Vbl : Next 
  34.    Wait 100
  35.    Fade 2,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F,$F
  36.    Wait 35
  37.    Fade 2
  38.    Wait 25
  39. End Proc
  40. Procedure KOLORY
  41.    For KOL=1 To Screen Colour
  42.       KOL(KOL)=Colour(KOL)
  43.    Next 
  44. End Proc
  45. Procedure PISZ[T$,X,Y,CZAS]
  46.    For NR=1 To Len(T$)
  47.       Ink 1
  48.       For NIC=1 To 15
  49.          Bar X+14-2*NIC+NIC,Y+14-2*NIC+NIC To X+16+NIC,Y+16+NIC
  50.       Next NIC
  51.       Wait Vbl 
  52.       Ink 15
  53.       For NIC=1 To 15
  54.          Bar X+14-2*NIC+NIC,Y+14-2*NIC+NIC To X+16+NIC,Y+16+NIC
  55.       Next NIC
  56.       ZNAK$=Mid$(T$,NR,1)
  57.       If ZNAK$<>" "
  58.          Paste Bob X,Y,Asc(ZNAK$)-64
  59.       End If 
  60.       X=X+32
  61.       If CZAS>0
  62.          Wait CZAS
  63.       End If 
  64.    Next 
  65. End Proc
  66. Procedure PISZ2[T$,X,Y,CZAS]
  67.    For NR=1 To Len(T$)
  68.       ZNAK$=Mid$(T$,NR,1)
  69.       If ZNAK$="*"
  70.          X=X-55
  71.       End If 
  72.       If ZNAK$<>" " and ZNAK$<>"*"
  73.          Paste Bob X,Y,Asc(ZNAK$)-64
  74.       End If 
  75.       X=X+32
  76.       If CZAS>0
  77.          Wait CZAS
  78.       End If 
  79.    Next 
  80. End Proc
  81. Procedure PISZ3[T$,X,Y,CZAS]
  82.    For NR=1 To Len(T$)
  83.       ZNAK$=Mid$(T$,NR,1)
  84.       If ZNAK$="*"
  85.          X=X-55
  86.       End If 
  87.       If ZNAK$<>" " and ZNAK$<>"*"
  88.          Paste Bob X,Y,Vrev(Asc(ZNAK$)-64)
  89.       End If 
  90.       X=X+32
  91.       If CZAS>0
  92.          Wait CZAS
  93.       End If 
  94.    Next 
  95. End Proc
  96. Procedure CREDITS
  97.    Screen Open 0,640,512,16,Hires+Laced
  98.    Screen Hide 0
  99.    Flash Off : Curs Off 
  100.    Palette $FFF,$111,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$DDD,$EEE,$FFF,$FFF
  101.    Colour Back $FFF
  102.    Cls 15
  103.    Screen Show 0
  104.    Track Play 6 : Track Loop On 
  105.    PISZ[" AFC  GROUP ",100,100,12]
  106.    PISZ["PRESENT",170,135,12]
  107.    PISZ["NEW DENTRO",110,170,12]
  108.    PISZ["CALLED",175,200,12]
  109.    PISZ["CHAOS",190,235,12]
  110.    Bob 1,340,220,27
  111.    Wait 100
  112.    For Y=41 To 260 Step 6
  113.       Screen Display 0,,Y,,
  114.       Wait Vbl 
  115.    Next 
  116.    Wait 40
  117.    For Y=260 To -260 Step -1
  118.       Screen Display 0,,Y,,
  119.    Next 
  120.    Screen Close 0
  121.    Colour Back 0
  122. End Proc
  123. Procedure CHESSBOARD_3D
  124.    Z=1
  125.    X=200
  126.    WSP=1
  127.    HA$(0)="CREDITS"
  128.    HA$(1)="CODE BY"
  129.    HA$(2)="DELTA"
  130.    HA$(3)="AND"
  131.    HA$(4)="STARLIGHT"
  132.    HA$(5)="GFX BY"
  133.    HA$(6)="TOOL AND ELVIS"
  134.    HA$(7)="ALL OF AFC"
  135.    HA$(8)="MUSIC BY"
  136.    HA$(9)="DELTA OF AFC"
  137.    Unpack 11 To 0
  138.    Screen Hide 0
  139.    Erase 11
  140.    Colour 31,$0
  141.    Screen Open 1,640,40,16,Hires
  142.    Screen Display 1,,160,,35
  143.    Flash Off : Get Bob Palette : Palette ,$0,,$B80 : Cls 0
  144.    Screen 0
  145.    Shift Up 1,8,23,1
  146.    Double Buffer 
  147.    Autoback 0
  148.    Gr Writing 2
  149.    TENCZA
  150.    Screen Show 0
  151.    For J=1 To 260
  152.       If J>10 and J<18
  153.          Screen 1
  154.          PISZ2[Mid$(HA$(0),WSP,1),X,2,0]
  155.          X=X+35
  156.          If WSP=5
  157.             X=X-20
  158.          End If 
  159.          Inc WSP
  160.          Screen 0
  161.       End If 
  162.       If J=25 Then Screen 1 : Cls 0 : WSP=1 : X=200 : Screen 0
  163.       If J>25 and J<33
  164.          Screen 1
  165.          PISZ2[Mid$(HA$(1),WSP,1),X,2,0]
  166.          X=X+35
  167.          Inc WSP
  168.          Screen 0
  169.       End If 
  170.       If J=40 Then Screen 1 : Screen 0 : X=200 : WSP=1
  171.       If J=49 Then Screen 1 : Cls 0 : Get Bob Palette : Palette ,,,$B80 : Cls 0 : Screen 0
  172.       If J>50 and J<56
  173.          Screen 1
  174.          PISZ2[Mid$(HA$(2),WSP,1),X,2,0]
  175.          X=X+35
  176.          Inc WSP
  177.          Screen 0
  178.       End If 
  179.       If J=60 Then Screen 1 : Cls 0 : WSP=1 : X=250 : Screen 0
  180.       If J>60 and J<64
  181.          Screen 1
  182.          PISZ2[Mid$(HA$(3),WSP,1),X,2,0]
  183.          X=X+35
  184.          Inc WSP
  185.          Screen 0
  186.       End If 
  187.       If J=70 Then Screen 1 : Cls 0 : WSP=1 : X=150 : Screen 0
  188.       If J>70 and J<80
  189.          Screen 1
  190.          PISZ2[Mid$(HA$(4),WSP,1),X,2,0]
  191.          X=X+35
  192.          If WSP=6
  193.             X=X-20
  194.          End If 
  195.          Inc WSP
  196.          Screen 0
  197.       End If 
  198.       If J=90 Then Screen 1 : Cls 0 : WSP=1 : X=150 : Screen 0
  199.       If J>90 and J<97
  200.          Screen 1
  201.          PISZ2[Mid$(HA$(5),WSP,1),X,2,0]
  202.          X=X+35
  203.          Inc WSP
  204.          Screen 0
  205.       End If 
  206.       If J=110 Then Screen 1 : Cls 0 : WSP=1 : X=75 : Screen 0
  207.       If J>110 and J<125
  208.          Screen 1
  209.          PISZ2[Mid$(HA$(6),WSP,1),X,2,0]
  210.          X=X+35
  211.          If WSP=13
  212.             X=X-20
  213.          End If 
  214.          Inc WSP
  215.          Screen 0
  216.       End If 
  217.       If J=125 Then Screen 1 : Screen 0 : X=100 : WSP=1
  218.       If J=135 Then Screen 1 : Cls 0 : Get Bob Palette : Palette ,,,$B80 : Cls 0 : Screen 0
  219.       If J>135 and J<146
  220.          Screen 1
  221.          PISZ2[Mid$(HA$(7),WSP,1),X,2,0]
  222.          X=X+35
  223.          If WSP=12
  224.             X=X-20
  225.          End If 
  226.          Inc WSP
  227.          Screen 0
  228.       End If 
  229.       If J=155 Then Screen 1 : Cls 0 : Get Bob Palette : Palette ,,,$B80 : Cls 0 : Screen 0 : WSP=1 : X=200
  230.       If J>155 and J<164
  231.          Screen 1
  232.          PISZ2[Mid$(HA$(8),WSP,1),X,2,0]
  233.          X=X+35
  234.          If WSP=4
  235.             X=X-20
  236.          End If 
  237.          If WSP=12
  238.             X=X-20
  239.          End If 
  240.          Inc WSP
  241.          Screen 0
  242.       End If 
  243.       If J=165 Then Screen 1 : Screen 0 : X=100 : WSP=1
  244.       If J=175 Then Screen 1 : Cls 0 : Get Bob Palette : Palette ,,,$B80 : Cls 0 : Screen 0
  245.       If J>175 and J<188
  246.          Screen 1
  247.          PISZ2[Mid$(HA$(9),WSP,1),X,2,0]
  248.          X=X+35
  249.          Inc WSP
  250.          Screen 0
  251.       End If 
  252.       If J>210 and J<240
  253.          Inc Z
  254.          Rainbow 1,,141+Z,60-Z*2
  255.       End If 
  256.       If J=200 Then Screen 1 : Cls 0 : Screen 0 : X=200 : WSP=1
  257.       Add I,2,1 To 360
  258.       SIZ=SN#(I)*30+40
  259.       BX=160+SN#(I*3)*100*SN#(I+90) : BY=128-SN#(I+I)*100*SN#(I)
  260.       PRV(1)=BX+SN#(I)*SIZ : PRV(2)=BY+SN#(I+270)*SIZ
  261.       PRV(3)=BX+SN#(I+90)*SIZ : PRV(4)=BY+SN#(I)*SIZ
  262.       PRV(5)=BX+SN#(I+180)*SIZ : PRV(6)=BY+SN#(I+90)*SIZ
  263.       PRV(7)=BX+SN#(I+270)*SIZ : PRV(8)=BY+SN#(I+180)*SIZ
  264.       Polygon PRV(9),PRV(10) To PRV(11),PRV(12) To PRV(13),PRV(14) To PRV(15),PRV(16)
  265.       Polygon PRV(1),PRV(2) To PRV(3),PRV(4) To PRV(5),PRV(6) To PRV(7),PRV(8)
  266.       PRV(9)=PRV(1)
  267.       PRV(10)=PRV(2)
  268.       PRV(11)=PRV(3)
  269.       PRV(12)=PRV(4)
  270.       PRV(13)=PRV(5)
  271.       PRV(14)=PRV(6)
  272.       PRV(15)=PRV(7)
  273.       PRV(16)=PRV(8)
  274.       Screen Swap 
  275.       Screen Copy Physic To Logic
  276.    Next J
  277.    Polygon PRV(1),PRV(2) To PRV(3),PRV(4) To PRV(5),PRV(6) To PRV(7),PRV(8)
  278.    Screen Swap 
  279.    Screen Copy Physic To Logic
  280.    Shift Off 
  281.    Rainbow Del 
  282.    Fade 3
  283.    Wait 40
  284.    Screen Close 0
  285.    Screen Close 1
  286. End Proc
  287. Procedure TENCZA
  288.    Set Rainbow 1,0,115,"","","(2,1,15)(2,-1,15)"
  289.    Rainbow 1,0,141,60
  290.    Channel 1 To Rainbow 1
  291.    Amal 1,"L:L X=1 ; F R1=1 T 61 ; L X =X+1 ; N R1 ; J L"
  292.    Amal On 
  293. End Proc
  294. Procedure ZJAZD_TENCZY
  295.    For Z=1 To 30
  296.       Rainbow 1,,141+Z,60-Z*2
  297.       Wait 3
  298.    Next 
  299.    Rainbow Del 
  300. End Proc
  301. Procedure _3DCUBE
  302.    Screen Open 0,320,256,2,Lowres
  303.    Flash Off : Curs Off : Cls 0
  304.    Set Rainbow 1,1,350,"(15,1,15)","(15,-1,15)","(15,1,15)"
  305.    Rainbow 1,1,75,340
  306.    Channel 1 To Rainbow 1
  307.    Amal 1,"L:L X=1 ; F R1=1 T 61 ; L X =X+1 ; N R1 ; J L"
  308.    Amal On 
  309.    For KOL=1 To 15
  310.       Colour KOL,NR
  311.       NR=NR+273
  312.    Next KOL
  313.    X_SR=160 : Rem - wspo�rzedna x srodka elipsy
  314.    Y_SR=100 : Rem - wspo�rzedna y srodka elipsy
  315.    X_PR=50 : Rem - d�ugosc osi poziomej elipsy
  316.    Y_PR=50 : Rem - d�ugosc osi pionowej elipsy
  317.    Degree : Rem - przejscie na miare stopniowa 
  318.    Double Buffer : Autoback 0 : Rem - uaktywnienie trybu double buffer   
  319.    Dim _SIN#(700),_COS#(700),X(4),Y(4) : Rem WSP(4),WSK(4)  
  320.    For ALFA=0 To 630
  321.       _SIN#(ALFA)=Sin(ALFA)
  322.       _COS#(ALFA)=Cos(ALFA)
  323.    Next 
  324.    WSP(1)=0
  325.    WSP(2)=1
  326.    WSP(3)=2
  327.    WSP(4)=3
  328.    For I=1 To 150
  329.       For ALFA=0 To 360 Step 5
  330.          If I>2 and I<50
  331.             If ALFA-5>0
  332.                ALFA=ALFA-5
  333.             End If 
  334.          End If 
  335.          Inc I
  336.          X(1)=X_SR+X_PR*_SIN#(ALFA)
  337.          Y(1)=Y_SR+Y_PR*_COS#(ALFA)
  338.          X(2)=X_SR+X_PR*_SIN#(ALFA+90)
  339.          Y(2)=Y_SR+Y_PR*_COS#(ALFA+90)
  340.          X(3)=X_SR+X_PR*_SIN#(ALFA+180)
  341.          Y(3)=Y_SR+Y_PR*_COS#(ALFA+180)
  342.          X(4)=X_SR+X_PR*_SIN#(ALFA+270)
  343.          Y(4)=Y_SR+Y_PR*_COS#(ALFA+270)
  344.          Cls 0
  345.          KOL=1
  346.          For T=1 To 10
  347.             Ink 1
  348.             Polyline X(1),Y(1) To X(2),Y(2) To X(3),Y(3) To X(4),Y(4) To X(1),Y(1)
  349.             For Z=1 To 4
  350.                X(Z)=X(Z)+WSP(Z) : Y(Z)=Y(Z)+WSP(Z)
  351.             Next Z
  352.          Next 
  353.          
  354.          For H=1 To 4
  355.             If WSP(H)<10 and WSK(H)=0
  356.                WSP(H)=WSP(H)+1
  357.             Else WSK(H)=1
  358.                If WSP(H)>0
  359.                   WSP(H)=WSP(H)-1
  360.                Else 
  361.                   WSK(H)=0
  362.                End If 
  363.             End If 
  364.          Next 
  365.          
  366.          Screen Swap 
  367.          Wait Vbl 
  368.          
  369.       Next ALFA
  370.       
  371.    Next I
  372.    Rainbow Del 
  373.    Cls 0
  374.    Screen Swap 
  375.    Amal Off 
  376. End Proc
  377. Procedure COPPER
  378.    Dim A(3)
  379.    A(1)=35
  380.    A(2)=35
  381.    A(3)=35
  382.    Screen Open 0,320,256,2,Lowres
  383.    Cls 0
  384.    KROK=1
  385.    For T=1 To 7
  386.       For Z=1 To 34
  387.          If T>2 Then Inc KROK
  388.          Set Rainbow 1,0,300,"("+Str$(A(1))+",1,"+Str$(A(1))+")","("+Str$(A(2))+",1,"+Str$(A(2))+")","("+Str$(A(3))+",1,"+Str$(A(3))+")"
  389.          Rainbow 1,1,1,300
  390.          Wait Vbl 
  391.          If T>1 or T<3 Then Dec A(1)
  392.          If T<2 or T>5 Then Dec A(2)
  393.          If T<3 or T>4 Then Dec A(3)
  394.       Next 
  395.       For Z=1 To 34
  396.          If T>2 Then Dec KROK
  397.          Set Rainbow 1,0,300,"("+Str$(A(1))+",1,"+Str$(A(1))+")","("+Str$(A(2))+",1,"+Str$(A(2))+")","("+Str$(A(3))+",1,"+Str$(A(3))+")"
  398.          Rainbow 1,1,1,300
  399.          Wait Vbl 
  400.          If T>1 or T<3 Then Inc A(1)
  401.          If T<2 or T>5 Then Inc A(2)
  402.          If T<3 or T>4 Then Inc A(3)
  403.       Next 
  404.    Next 
  405.    Rainbow Del 
  406. End Proc
  407. Procedure LUSTRO
  408.    Screen Open 0,320,256,4,Lowres
  409.    Palette $0,$FFF,$A,$0
  410.    Curs Off : Flash Off : Cls 0
  411.    For P=0 To 160
  412.       WSK(P)=0
  413.    Next P
  414.    Bar 0,128 To 320,256
  415.    X=160
  416.    Y=128
  417.    Y1=256-Y
  418.    Ink 1,1,1
  419.    Plot X,Y
  420.    For TZ=1 To 7500
  421.       Repeat 
  422.          A=Rnd(3)
  423.          If A=0 Then X=X+2
  424.          If A=1 Then X=X-2
  425.          If A=2 Then Y=Y+2
  426.          If A=3 Then Y=Y-2
  427.          If Y>128 Then Y=128
  428.          If Y<0 Then Y=0
  429.          If X>320 Then X=320
  430.          If X<0 Then X=0
  431.          Y1=190-Y/2
  432.          Inc TZ
  433.       Until Point(X,Y)<>1
  434.       Plot X,Y
  435.       Plot X,Y1
  436.    Next TZ
  437.    Def Scroll 1,0,128 To 640,255,0,1
  438.    Def Scroll 2,0,0 To 640,128,0,-1
  439.    For T=1 To 130
  440.       Scroll 1
  441.       Scroll 2
  442.    Next 
  443.    Fade 1,$FFF,$FFF,$FFF,$FFF
  444.    Wait 15
  445.    Cls 0
  446.    Fade 1
  447.    Wait 15
  448. End Proc
  449. Procedure INIT_FALA[POCZ,KON]
  450.    L=0
  451.    W=0
  452.    For NR=POCZ To KON
  453.       WSP(NR)=L
  454.       If L<5 and W=0
  455.          Inc L
  456.       Else 
  457.          W=1
  458.       End If 
  459.       If L>0 and W=1
  460.          Dec L
  461.       Else 
  462.          W=0
  463.       End If 
  464.    Next NR
  465. End Proc
  466. Procedure FALA[POCZ,KON,EKR]
  467.    For Y_POS=POCZ To KON
  468.       If WSP(Y_POS)<5 and WSK(Y_POS)=0
  469.          Inc WSP(Y_POS)
  470.          Screen Copy EKR,0,Y_POS,639,Y_POS+1 To EKR,WSP(Y_POS),Y_POS
  471.       Else 
  472.          WSK(Y_POS)=1
  473.       End If 
  474.       If WSP(Y_POS)>0 and WSK(Y_POS)=1
  475.          Screen Copy EKR,0,Y_POS,639,Y_POS+1 To EKR,-WSP(Y_POS),Y_POS
  476.          Dec WSP(Y_POS)
  477.       Else 
  478.          WSK(Y_POS)=0
  479.       End If 
  480.    Next Y_POS
  481. End Proc
  482. Procedure _SCROLL
  483.    Unpack 12 To 1
  484.    Screen Hide 1
  485.    Erase 12
  486.    Screen Display 1,,45,,90
  487.    Shift Up 1,0,31,1
  488.    Screen Open 0,320,256,16,Lowres
  489.    Cls 0 : Flash Off : Curs Off : Cls 0
  490.    Screen To Front 1
  491.    Get Bob Palette 
  492.    Palette ,,$A,$B80
  493.    Dim T$(33)
  494.    T$(1)="GREETS TO"
  495.    T$(2)=" UNI*ON"
  496.    T$(3)=" MYSTI*C"
  497.    T$(4)="FREEZERS"
  498.    T$(5)=" VACUUM"
  499.    T$(6)=" DEPTH"
  500.    T$(7)="  CLAN"
  501.    T$(8)=" TURNI*PS"
  502.    T$(9)="  SCUM"
  503.    T$(10)=" S A F"
  504.    T$(11)="ANADUNE"
  505.    T$(12)="  CSP"
  506.    T$(13)="THEFECT"
  507.    T$(14)=" CARTEL"
  508.    T$(15)=" SKULLS"
  509.    T$(16)=" CONVEX"
  510.    T$(17)="SADI*ST"
  511.    T$(18)=" FI*RE"
  512.    T$(19)=" VENAL"
  513.    T$(20)="PHANTASM"
  514.    T$(21)="ALBI*ON"
  515.    T$(22)="OPTI*CORE"
  516.    T$(23)=" BUCKET"
  517.    T$(24)="CASYOPEA"
  518.    T$(25)=" TATET"
  519.    T$(26)="ASPHYXI*A"
  520.    T$(27)=" FUTURE"
  521.    T$(28)="OBSESI*ON"
  522.    T$(29)=" I*RI*S"
  523.    T$(30)="APPENDI*X"
  524.    T$(31)="GENETI*C"
  525.    T$(32)="  ZOMO"
  526.    T$(33)="AND REST"
  527.    Bar 0,128 To 640,256
  528.    WSK=0
  529.    Screen Show 1
  530.    Channel 15 To Screen Offset 1 : Amal 15,"L: FR0=1T20;LY=R0;LX=R0;P;NR0;FR0=1T18;LY=20-R0;LX=20-R0;P;NR0;JL"
  531.    Amal On 
  532.    Screen 0
  533.    Do 
  534.       INIT_FALA[128,156]
  535.       Inc WSK
  536.       PISZ2[T$(WSK),20,100,0]
  537.       PISZ3[T$(WSK),20,129,0]
  538.       For G=1 To 20
  539.          FALA[128,156,0]
  540.       Next G
  541.       Fade 1,,,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
  542.       For TA=1 To 9
  543.          FALA[128,156,0]
  544.       Next 
  545.       Ink 2
  546.       Bar 0,128 To 640,256
  547.       Fade 1,,,$A,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  548.       For TA=1 To 9
  549.          FALA[128,156,0]
  550.       Next 
  551.       Ink 0
  552.       Bar 0,100 To 639,128
  553.       Get Bob Palette : Palette ,,,$B80
  554.       Palette ,,$A
  555.       Exit If WSK=33
  556.    Loop 
  557.    Screen Close 0
  558.    Screen Close 1
  559.    Amal Off 
  560. End Proc
  561. Procedure BRY�Y
  562.    Dim _SIN#(700),_COS#(700),X(4),Y(4)
  563.    For ALFA=0 To 630
  564.       _SIN#(ALFA)=Sin(ALFA)
  565.       _COS#(ALFA)=Cos(ALFA)
  566.    Next 
  567.    Screen Open 0,400,200,4,Lowres
  568.    Screen Open 1,320,130,16,Lowres
  569.    Screen Hide 1
  570.    Flash Off : Curs Off : Cls 0
  571.    Get Bob Palette : Palette ,,,$B80
  572.    Screen Display 1,,220,,
  573.    Screen 0
  574.    Get Bob Palette : Palette $FFF,$0 : Palette ,,,$B80
  575.    Flash Off : Curs Off : Cls 1
  576.    Screen Display 0,110,20,,
  577.    Set Rainbow 1,2,350,"(15,2,11)","(5,-1,1)","(11,-3,14)"
  578.    Rainbow 1,1,75,340
  579.    Channel 1 To Rainbow 1
  580.    Amal 1,"L:L X=1 ; F R1=1 T 161 ; L X =X+1 ; N R1 ; J L"
  581.    Amal On 
  582.    X_SR=200
  583.    Y_SR=150
  584.    X_PR=50
  585.    Y_PR=20
  586.    XX=200
  587.    YY=70
  588.    WSP(1)=10 : WSK(1)=0
  589.    WSP(2)=20 : WSK(2)=0
  590.    WSP(3)=30 : WSK(3)=0
  591.    WSP(4)=40 : WSK(4)=0
  592.    Degree 
  593.    Double Buffer : Autoback 0
  594.    '   INIT_FALA[10,38] 
  595.    Screen 1
  596.    PISZ2["COPPER",70,10,0]
  597.    PISZ2["RULES",90,40,0]
  598.    Screen Show 1
  599.    Screen 0
  600.    '   Screen Swap  
  601.    '   Screen Copy Physic To Logic
  602.    For I=1 To 4
  603.       For ALFA=0 To 360 Step 4
  604.          
  605.          X1=X_SR+X_PR*_SIN#(ALFA)
  606.          Y1=Y_SR+Y_PR*_COS#(ALFA)
  607.          X2=X_SR+X_PR*_SIN#(ALFA+120)
  608.          Y2=Y_SR+Y_PR*_COS#(ALFA+120)
  609.          X3=X_SR+X_PR*_SIN#(ALFA+240)
  610.          Y3=Y_SR+Y_PR*_COS#(ALFA+240)
  611.          
  612.          X4=X_SR+X_PR*_SIN#(360-ALFA)
  613.          Y4=Y_SR+Y_PR*_COS#(360-ALFA)
  614.          X5=X_SR+X_PR*_SIN#(360-ALFA+90)
  615.          Y5=Y_SR+Y_PR*_COS#(360-ALFA+90)
  616.          X6=X_SR+X_PR*_SIN#(360-ALFA+180)
  617.          Y6=Y_SR+Y_PR*_COS#(360-ALFA+180)
  618.          X7=X_SR+X_PR*_SIN#(360-ALFA+270)
  619.          Y7=Y_SR+Y_PR*_COS#(360-ALFA+270)
  620.          Ink 1
  621.          Bar 0,0 To 340,190
  622.          Ink 2
  623.          ' ostros�up  
  624.          Polyline X1,Y1 To X2,Y2 To XX,YY To X1,Y1 To X3,Y3 To XX,YY To X3,Y3 To X2,Y2
  625.          'sze�cian
  626.          Polyline X4,Y4 To X5,Y5 To X6,Y6 To X7,Y7 To X4,Y4
  627.          Polyline X4,Y4-70+WSP(1) To X5,Y5-70+WSP(2) To X6,Y6-70+WSP(3) To X7,Y7-70+WSP(4) To X4,Y4-70+WSP(1)
  628.          Polyline X4,Y4 To X4,Y4-70+WSP(1)
  629.          Polyline X5,Y5 To X5,Y5-70+WSP(2)
  630.          Polyline X6,Y6 To X6,Y6-70+WSP(3)
  631.          Polyline X7,Y7 To X7,Y7-70+WSP(4)
  632.          For Z=1 To 4
  633.             If WSK(Z)=0
  634.                Inc WSP(Z)
  635.             End If 
  636.             If WSK(Z)=1
  637.                Dec WSP(Z)
  638.             End If 
  639.             If WSP(Z)=-20 Then WSK(Z)=0
  640.             If WSP(Z)>50 Then WSK(Z)=1
  641.          Next Z
  642.          'Screen 1
  643.          'FALA[10,38,1] 
  644.          'Screen 0
  645.          Screen Swap 
  646.       Next ALFA
  647.    Next I
  648.    Rainbow Del 
  649.    Screen Close 0
  650.    Screen Close 1
  651.    Amal Off 
  652. End Proc
  653. Procedure _SINUS
  654.    Screen Open 0,320,230,2,Lowres
  655.    Palette $0,$FFF : Cls 0 : Flash Off : Curs Off : Cls 0
  656.    Double Buffer : Autoback 0
  657.    INIT_FALA[0,41]
  658.    For Z=1 To 61
  659.       WSK(Z)=0
  660.    Next 
  661.    For U=1 To 70
  662.       Cls 0
  663.       X1=100 : Y1=10 : NR=0
  664.       For Y=Y1 To Y1+200 Step 5
  665.          Ink 1
  666.          Draw X+WSP(NR),Y+WSP(NR) To X-WSP(NR)+300,Y+WSP(NR)
  667.          X1=X1+5
  668.          Y1=Y1+5
  669.          Inc NR
  670.       Next 
  671.       Screen Swap 
  672.       For S=0 To 41
  673.          If WSP(S)<5 and WSK(S)=0
  674.             Inc WSP(S)
  675.          Else 
  676.             WSK(S)=1
  677.          End If 
  678.          If WSP(S)>0 and WSK(S)=1
  679.             Dec WSP(S)
  680.          Else 
  681.             WSK(S)=0
  682.          End If 
  683.       Next S
  684.    Next U
  685.    Cls 0
  686.    Screen Swap 
  687. End Proc
  688. Procedure AKFARELA[X,Y,ILE,KOLOR]
  689.    Screen Open 0,320,256,16,Lowres
  690.    Cls 0 : Flash Off : Curs Off 
  691.    If KOLOR=0
  692.       Palette $0,$1,$2,$3,$4,$5,$6,$7,$8,$9,$A,$B,$C,$D,$E,$F
  693.    End If 
  694.    If KOLOR=1
  695.       Palette $0,$11,$22,$33,$44,$55,$66,$77,$88,$99,$AA,$BB,$CC,$DD,$EE,$FF
  696.    End If 
  697.    If KOLOR=2
  698.       Palette $0,$111,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  699.    End If 
  700.    Randomize Timer
  701.    Ink 1,1,1
  702.    For S=1 To ILE
  703.       POWROT:
  704.       A=Rnd(1)
  705.       B=Rnd(1)
  706.       If A=0 Then X=X+1
  707.       If A=1 Then X=X-1
  708.       If X>Screen Width or X<0
  709.          If X>Screen Width : X=X-1 : Goto POWROT : End If 
  710.          If X<0 : X=X+1 : Goto POWROT : End If 
  711.       End If 
  712.       If Point(X,Y)>0
  713.          Ink Point(X,Y)+1,Point(X,Y)+1,Point(X,Y)+1
  714.       Else 
  715.          Ink 2,2,2
  716.       End If 
  717.       Plot X,Y
  718.       If B=0 Then Y=Y+1
  719.       If B=1 Then Y=Y-1
  720.       If Y>Screen Height or Y<0
  721.          If Y>Screen Height : Y=Y-1 : Goto POWROT : End If 
  722.          If Y<0 : Y=Y+1 : Goto POWROT : End If 
  723.       End If 
  724.       If Point(X,Y)>0
  725.          Ink Point(X,Y)+1,Point(X,Y)+1,Point(X,Y)+1
  726.       Else 
  727.          Ink 2,2,2
  728.       End If 
  729.       Plot X,Y
  730.    Next S
  731. End Proc
  732. Procedure BLOKUJ
  733.    Amos To Front 
  734.    Amos Lock 
  735.    Break Off 
  736.    Close Workbench 
  737.    Request Off 
  738.    Hide 
  739.    Led Off 
  740. End Proc
  741. Procedure BAD
  742.    Track Stop 
  743.    Do 
  744.       Cls 0
  745.    Loop 
  746. End Proc
  747. Procedure ELVIS
  748.    Unpack 13 To 0 : Erase 13 : Palette $0
  749.    Screen Open 1,320,256,64,Lowres
  750.    Curs Off : Flash Off : Cls 0 : Get Palette 0
  751.    For Y=-10 To 256
  752.       JJ=Y
  753.       For J=Y+30 To Y+20 Step -1 : Screen Copy 0,0,J,320,J+1 To 1,0,JJ : Inc JJ : Next J
  754.       Screen Copy 0,0,Y,320,Y+1 To 1,0,Y
  755.    Next 
  756.    Wait 100 : Ink 0
  757.    For Y=256 To -10 Step -1
  758.       JJ=Y
  759.       For J=Y+30 To Y+20 Step -1 : Screen Copy 0,0,J,320,J+1 To 1,0,JJ : Inc JJ : Next J
  760.       Polyline 0,Y+10 To 630,Y+10 : Screen Copy 0,0,Y,320,Y+1 To 1,0,Y
  761.    Next 
  762.    Screen Close 0
  763.    Screen Close 1
  764. End Proc
  765. Procedure _END_SCROLL
  766.    Unpack 14 To 0
  767.    Erase 14
  768.    For R=-40 To 40
  769.       Screen Display 0,,R,,
  770.       Wait Vbl 
  771.    Next 
  772.    Double Buffer : Autoback 0
  773.    Def Scroll 1,0,65 To 640,256,0,-1
  774.    Dim T$(110)
  775.    Restore DATY
  776.    For T=0 To 100
  777.       Read H$
  778.       If H$<>"***"
  779.          T$(T)=H$
  780.       Else 
  781.          Exit 
  782.       End If 
  783.    Next 
  784.    WSK=0
  785.    Gr Writing 0
  786.    Do 
  787.       Ink 2,0,0
  788.       Text 10,252,T$(WSK)
  789.       Ink 3,0,0
  790.       Text 11,253,T$(WSK)
  791.       For U=1 To 20
  792.          S:
  793.          If Mouse Key=1 Then Goto S
  794.          If Mouse Key=2
  795.             Fade 2,,,$0,$0
  796.             Wait 25
  797.             Ink 0 : Bar 0,64 To 640,256 : Screen Swap 
  798.             Fade 2,,,$555,$FFF
  799.             Wait 25
  800.             For R=40 To -40 Step -1
  801.                Screen Display 0,,R,,
  802.                Wait Vbl 
  803.             Next 
  804.             End 
  805.          End If 
  806.          Scroll 1
  807.          Screen Swap 
  808.          Screen Copy Physic To Logic
  809.          Wait Vbl 
  810.       Next 
  811.       If WSK<105
  812.          Inc WSK
  813.       Else 
  814.          WSK=0
  815.       End If 
  816.    Loop 
  817.    DATY:
  818.    Data "Teraz troch� po polsku (jak nie masz polskich liter to ju� tfuj proplem)..."
  819.    Data "LMB - zatrzymaj przewijacz                          RMB - olej przewijacz"
  820.    Data ""
  821.    Data "Na wst�pie korzystaj�c z tego i� mog�  zasi��� do scrolla"
  822.    Data "(DELTA ON LINE) napisz� co� o demku. "
  823.    Data "Og�lnie m�wi�c to demko jest kodowane przeze mnie pr�cz jednego"
  824.    Data "efektu - lataj�cy kwadrat podczas credits'�w. A szczeg��owo to..."
  825.    Data "Po pierwsze pomys� zrodzi� si� w mojej (jak�e wspania�ej) g��wce."
  826.    Data "Ni st�d ni z ow�d pomy�la�em ï¿½e warto by co� napsa� zwa�ywszy na zbli�aj�ce"
  827.    Data "si� pozna�skie party."
  828.    Data "No i jak si� wzi��em to by�o wporz�dku do czasu gdy potrzebowa�em grafiki."
  829.    Data "Jako ï¿½e by�o ma�o czasu musia�em podi�� si� czynno�ci kt�rej bardzo nie lubi�."
  830.    Data "Dok�adniej rzecz bior�c zmuszony by�em do wyrypania dw�ch rysunk�w ze starej "
  831.    Data "produkcji AFC - NITROSACHAROZY (czy jako� tak). W demku s� umieszczone dwa"
  832.    Data "rysunki. Pierwszy z nich 'ALIEN SOLDIER' jest autorstwa TOOL'a, drugi - "
  833.    Data "'MISTS OF AVALON - DEATH' to dzie�o ELVISA. No i grafika ju� jest. Muzyka jest "
  834.    Data "moja, bo nie by�o czasu aby prosi� o ni� INVERTa. Potem przysz�o na"
  835.    Data "dopracowanie kodu. Chcia�em aby demko odplala�o na jednym mega. I tu zacz��y "
  836.    Data "si� 'schody'. A bo to raz muzyka by�a za d�uga, raz brak�o pami�ci na strefy "
  837.    Data "scrolla, ect., ect., ect... ."
  838.    Data "Poza tym to i tak by�em w dobrej sytuacji bo mia�em w domu dwie Amigi."
  839.    Data "Pierwsza - czyli moja 500 PLUS z 4MB RAM i Hadekiem i druga, Amiga od kuzynka,"
  840.    Data "zwyk�a pi��setka z 1 MB ramu. Wystarczy�o demko skompilowa� i przej�� do "
  841.    Data "pokoju obok aby ... dosta� komunikat 'Out of memory' i si� ostro wkurzy�. "
  842.    Data "Za kt�rym� odpaleniem demko by�o OK!. Tak, ale jest jeszcze ma�y problem"
  843.    Data "Bo pisz�� tego scrolla demko zwi�ksza swoj� d�ugo�� i mo�e znowu si� kashani�."
  844.    Data "Jak si� nadal b�dzie wali� to nic na to nie poradz� (nie urw� fragmentu kodu!)."
  845.    Data ""
  846.    Data "Dobra, mo�e by to ju� zako�czy�..."
  847.    Data "Troch� g�upio ko�czy� skorla tak wcze�nie, dopiero mamy... 16:45."
  848.    Data "W�a�nie zapomnia�em ï¿½e nie poda�em dzisiejszej daty - 06.06.1996."
  849.    Data "Mo�e za par� lat kto� b�dzie ogl�da� to demko."
  850.    Data ""
  851.    Data ""
  852.    Data "Teraz wrajtn� troch� mesejd�y...:"
  853.    Data ""
  854.    Data "DELTA/AFC <> FRED/R.N.O."
  855.    Data "Ty (CENSORED) czemu piszesz do mnie takie kr�tkie noty."
  856.    Data "M�g�by� napisa� co� wi�cej."
  857.    Data ""
  858.    Data "DELTA/AFC <> MADMAN/IND."
  859.    Data "Kiedy sko�czysz z psychodeli�... Tak w og�le to jojnuj"
  860.    Data "si� do jakie� grupki, a nie obijaj si�."
  861.    Data ""
  862.    Data "DELTA/AFC <> STARLIGHT/AFC"
  863.    Data "I co s�dzisz o tym demku... Dzi�ki za source RnB"
  864.    Data ""
  865.    Data "DELTA/AFC <> VOOK/AFC"
  866.    Data "Dzi�ki za source RnB. RnB jest cool..."
  867.    Data ""
  868.    Data "DELTA/AFC <> HANGMAN/DEPTH"
  869.    Data "Sorry, ï¿½e tak d�ugo nie pisa�em ale nie mia�em czasu, "
  870.    Data "bo zaj�ty by�em pisaniem tego denterka."
  871.    Data "Soon napisz�..."
  872.    Data ""
  873.    Data "Pozdrownienia from DELTA dla nast�puj�cych ludk�w:"
  874.    Data ""
  875.    Data "A-Down"
  876.    Data "Ace"
  877.    Data "Benton"
  878.    Data "Entrix"
  879.    Data "Fred"
  880.    Data "Hangman"
  881.    Data "Hiv"
  882.    Data "Invert"
  883.    Data "Kismat"
  884.    Data "Ko$mi"
  885.    Data "Korball"
  886.    Data "Madman"
  887.    Data "Mc. Rudi"
  888.    Data "Morino"
  889.    Data "Norman"
  890.    Data "Orion"
  891.    Data "The Tergent"
  892.    Data "Timer"
  893.    Data "Skizo"
  894.    Data "Starlight"
  895.    Data "Sweetvoice"
  896.    Data "Sydan"
  897.    Data "Timer"
  898.    Data "Vook"
  899.    Data "Zool"
  900.    Data "i reszta kt�r� zapomnia�em..."
  901.    Data ""
  902.    Data "No to na tyle pisania, bo nie samym scrollem cz�owiek ï¿½yje."
  903.    Data "Na koniec adresicki:"
  904.    Data "DELTA/AFC                           MC. RUDI "
  905.    Data "�ukasz ï¿½elezny                      Wojtek Nowak"
  906.    Data "ul. W�oska 4d/6                     ul. Czerwonych Klon�w 5/2"
  907.    Data "42-600 Tarnowskie G�ry              33-101 Tarn�w"
  908.    Data "POLAND                              POLAND"
  909.    Data "tel. 1-85-42-85 (wew. 560)   "
  910.    Data ""
  911.    Data ""
  912.    Data ""
  913.    Data ""
  914.    Data ""
  915.    Data ""
  916.    Data ""
  917.    Data ""
  918.    Data "RESTART SCROLL"
  919.    Data ""
  920.    Data ""
  921.    Data ""
  922.    Data "***"
  923. End Proc
  924. Procedure ROTATOR
  925.    Screen Open 0,320,256,8,Lowres
  926.    Screen Hide 0
  927.    Flash Off : Curs Off : Cls 0 : Palette $0,$222,$444,$666,$888,$AAA,$CCC,$EEE
  928.    For X=1 To 320 Step 120
  929.       PISZ["AFC",X,128,0]
  930.    Next 
  931.    Screen Open 1,320,256,8,Lowres
  932.    Cls 0 : Curs Off : Flash Off : Get Palette 0 : Cls 0
  933.    ZOM=0 : I=0
  934.    X1=140 : X2=180
  935.    Y1=108 : Y2=148
  936.    Ink 8 : Box 128,97 To 181,149
  937.    Ink 7 : Box 127,96 To 182,150
  938.    Ink 6 : Box 126,95 To 183,151
  939.    Ink 5 : Box 125,94 To 184,152
  940.    Ink 4 : Box 124,93 To 185,153
  941.    Ink 3 : Box 123,92 To 186,154
  942.    Pen 7 : Paper 0
  943.    Locate 14,10 : Print "ZOOM - ROTATOR"
  944.    For PP=1 To 3
  945.       ZOM=0 : I=0
  946.       X1=140 : X2=180
  947.       Y1=108 : Y2=148
  948.       Repeat 
  949.          Trap Zoom 0,X1-ZOM-I,Y1-ZOM+I,X2+ZOM+I,Y2+ZOM-I To 1,130,98,180,148
  950.          ZOM=ZOM+15
  951.          X1=X1-4
  952.          Y1=Y1+2
  953.          X2=X2-5
  954.          X2=X2+3
  955.       Until ZOM>50
  956.       Repeat 
  957.          Trap Zoom 0,X1-ZOM-I,Y1-ZOM+I,X2+ZOM+I,Y2+ZOM-I To 1,130,98,180,148
  958.          ZOM=ZOM-15
  959.          X1=X1+2
  960.          Y1=Y1-4
  961.          X2=X2+5
  962.          X2=X2-1
  963.       Until ZOM<-10
  964.       Repeat 
  965.          Trap Zoom 0,X1-ZOM-I,Y1-ZOM+I,X2+ZOM+I,Y2+ZOM-I To 1,130,98,180,148
  966.          ZOM=ZOM+5
  967.          X1=X1-2
  968.          Y1=Y1+4
  969.          X2=X2-5
  970.          X2=X2+1
  971.       Until ZOM>50
  972.       Repeat 
  973.          Trap Zoom 0,X1-ZOM-I,Y1-ZOM+I,X2+ZOM+I,Y2+ZOM-I To 1,130,98,180,148
  974.          ZOM=ZOM-5
  975.          X1=X1+4
  976.          Y1=Y1-2
  977.          X2=X2+5
  978.          X2=X2-3
  979.       Until ZOM<-10
  980.    Next PP
  981.    Screen Close 0
  982.    Screen Close 1
  983. End Proc